home *** CD-ROM | disk | FTP | other *** search
/ Programming Languages Suite / ProgramD2.iso / Languages / MS Cobol4.5 / DEMO / POPUP.CBL < prev    next >
Text File  |  1991-04-08  |  7KB  |  223 lines
  1.       $set ans85 noosvs mf
  2.       ************************************************************
  3.       *                              *
  4.       *          (C) Micro Focus Ltd. 1989             *
  5.       *                              *
  6.       *             POPUP.CBL                 *
  7.       *                              *
  8.       *                              *
  9.       *   This program illustrates how to simulate POPUP MENUS     *
  10.       *                              *
  11.       *   Internal calls used by this program:             *
  12.       *                              *
  13.       *           x"af"  -    Used to detect the use of cursor *
  14.       *             keys.                 *
  15.       *                              *
  16.       *           x"e5"  -    Used to sound the audible alarm. *
  17.       *                              *
  18.       * CBL_READ_SCR_CHATTRS -    Used to read the characters and  *
  19.       *             attributes on the screen.     *
  20.       *                              *
  21.       * CBL_WRITE_SCR_CHATTRS-    Used to write the characters and *
  22.       *             attributes on the screen.     *
  23.       *                              *
  24.       * CBL_WRITE_SCR_ATTRS  -    Used to set the characters     *
  25.       *             on the screen.             *
  26.       *                              *
  27.       *     CBL_SET_CSR_POS  -    Used to turn the cursor off.     *
  28.       *                              *
  29.       *                              *
  30.       ************************************************************
  31.  
  32.        working-storage section.
  33.        01 screen-position.
  34.        05 screen-row       pic 9(2) comp-x value 05.
  35.        05 screen-col       pic 9(2) comp-x value 15.
  36.        01 string-length        pic 9(4) comp-x value 15.
  37.  
  38.        01 top-row           pic 9(2) comp-x value 05.
  39.        01 bottom-row           pic 9(2) comp-x value 14.
  40.  
  41.        01 reverse-vid           pic x(15) value all x"70".
  42.        01 black-and-white      pic x(15) value all x"07".
  43.  
  44.        01 screen-origin        pic 9(4) comp-x value 0.
  45.        01 screen-buffer        pic x(2000).
  46.        01 screen-attrs           pic x(2000).
  47.        01 screen-string-length pic 9(4) comp-x value 2000.
  48.  
  49.        01 get-single-char      pic 9(2) comp-x value 26.
  50.        01 key-status.
  51.        05 key-type           pic x.
  52.        05 key-code-1       pic 9(2) comp-x.
  53.        05 key-code-2       pic 9(2) comp-x.
  54.  
  55.        01 set-bit-pairs        pic 9(2) comp-x value 1.
  56.        01 user-key-control.
  57.        05 user-key-setting pic 9(2) comp-x value 1.
  58.        05 filler           pic x value "1".
  59.        05 first-user-key   pic 9(2) comp-x value 1.
  60.        05 number-of-keys   pic 9(2) comp-x value 4.
  61.  
  62.        78 user-fn-key           value "1".
  63.        78 adis-fn-key           value "2".
  64.  
  65.        78 f1-key           value 1.
  66.        78 f2-key           value 2.
  67.        78 f3-key           value 3.
  68.        78 f4-key           value 4.
  69.  
  70.        78 carriage-return      value 0.
  71.        78 up-arrow           value 5.
  72.        78 down-arrow           value 6.
  73.  
  74.        01 cursor-off-screen.
  75.        05 row-number       pic 99 comp-x value 255.
  76.        05 col-number       pic 99 comp-x value 255.
  77.  
  78.  
  79.        screen section.
  80.        01 g-picscrn.
  81.        05 blank screen.
  82.        05 line  6 col 16 value  "Option one".
  83.        05 line  9 col 16 value  "Option two".
  84.        05 line 12 col 16 value "Option three".
  85.        05 line 15 col 16 value "Option four".
  86.        05 line 21 col 10 value "F1=Help    F2=Window1    F3=Window2
  87.       -"  F4=Clear windows".
  88.        05 line 22 col 10 value "Use  or  to point to an item, and
  89.       -"<Enter> to Terminate.".
  90.  
  91.        01   hilite3-00 highlight.
  92.        05 line 06  col 37 value "┌────────────────────────┐".
  93.        05 line 07  col 37 value "│ this is pop-up menu #1 │".
  94.        05 line 08  col 37 value "│                  │".
  95.        05 line 09  col 37 value "│ this menu could be     │".
  96.        05 line 10  col 37 value "│ your help menus          │".
  97.        05 line 11  col 37 value "│                  │".
  98.        05 line 12  col 37 value "│ It was brought up with │".
  99.        05 line 13  col 37 value "│ F1.              │".
  100.        05 line 14  col 37 value "│                  │".
  101.        05 line 15  col 37 value "└────────────────────────┘".
  102.  
  103.        01   hilite4-00 reverse-video.
  104.        05 col 1.
  105.        05 line 04 value "┌────────────────────────┐".
  106.        05 line 05 value "│ this is pop-up menu #2 │".
  107.        05 line 06 value "│                  │".
  108.        05 line 07 value "│ notice that the menus  │".
  109.        05 line 08 value "│ can overlay one another│".
  110.        05 line 09 value "│                  │".
  111.        05 line 10 value "│ the attribute you use  │".
  112.        05 line 11 value "│ is determined in the   │".
  113.        05 line 12 value "│ screen section          │".
  114.        05 line 13 value "│                  │".
  115.        05 line 14 value "│ this screen is turned  │".
  116.        05 line 15 value "│ on by F2           │".
  117.        05 line 16 value "└────────────────────────┘".
  118.  
  119.        01   hilite5-00     .
  120.        05 line 13 value "┌──────────────────────────────────────┐".
  121.        05 line 14 value "│      This screen is pop-up menu #2     │".
  122.        05 line 15 value "│                        │".
  123.        05 line 16 value "│Take turns in pressing F1, F2, F3     │".
  124.        05 line 17 value "│F4 in any order you wish.  Notice that│".
  125.        05 line 18 value "│you can overlay any and all menus and │".
  126.        05 line 19 value "│F4 will clear off back to the original│".
  127.        05 line 20 value "│menu.                    │".
  128.        05 line 21 value "│                        │".
  129.        05 line 22 value "│Function key # 3 pops-up this screen. │".
  130.        05 line 23 value "└──────────────────────────────────────┘".
  131.  
  132.        procedure division.
  133.        main-line.
  134.        perform start-up
  135.        perform which-key-loop
  136.            until key-type = adis-fn-key
  137.          and key-code-1 = carriage-return
  138.        stop run.
  139.  
  140.        start-up.
  141.       * Display user screen
  142.        display g-picscrn
  143.  
  144.       * Move cursor off screen
  145.        call "CBL_SET_CSR_POS" using cursor-off-screen
  146.  
  147.       * Read the current screen for later re-display
  148.        call "CBL_READ_SCR_CHATTRS" using screen-origin
  149.                           screen-buffer
  150.                           screen-attrs
  151.                           screen-string-length
  152.  
  153.       * Display first block
  154.        perform mark-block
  155.  
  156.       * Enable function keys
  157.        call x"af" using set-bit-pairs
  158.                 user-key-control
  159.        .
  160.  
  161.  
  162.        which-key-loop.
  163.        call x"af" using get-single-char
  164.                 key-status
  165.        evaluate key-type
  166.          when user-fn-key
  167.            evaluate key-code-1
  168.          when f1-key       display hilite3-00
  169.          when f2-key       display hilite4-00
  170.          when f3-key       display hilite5-00
  171.          when f4-key       perform clear-pop-up
  172.          when other       call x"e5"
  173.            end-evaluate
  174.          when adis-fn-key
  175.            evaluate key-code-1
  176.          when up-arrow       perform move-block-up
  177.          when down-arrow   perform move-block-down
  178.          when other       call x"e5"
  179.            end-evaluate
  180.        end-evaluate.
  181.  
  182.        pop-up-help.
  183.  
  184.        pop-up-story1.
  185.  
  186.        pop-up-story2.
  187.  
  188.        clear-pop-up.
  189.       * recover the original screen *
  190.        call "CBL_WRITE_SCR_CHATTRS" using screen-origin
  191.                           screen-buffer
  192.                           screen-attrs
  193.                           screen-string-length
  194.        perform mark-block.
  195.  
  196.        move-block-up.
  197.        perform clear-block
  198.        if screen-row > top-row
  199.            subtract 3 from screen-row
  200.        else
  201.            move bottom-row to screen-row
  202.        end-if
  203.        perform mark-block.
  204.  
  205.        move-block-down.
  206.        perform clear-block
  207.        if screen-row < bottom-row
  208.            add 3 to screen-row
  209.        else
  210.            move top-row to screen-row
  211.        end-if
  212.        perform mark-block.
  213.  
  214.        clear-block.
  215.        call "CBL_WRITE_SCR_ATTRS" using screen-position
  216.                         black-and-white
  217.                         string-length.
  218.  
  219.        mark-block.
  220.        call "CBL_WRITE_SCR_ATTRS" using screen-position
  221.                         reverse-vid
  222.                         string-length.
  223.